home *** CD-ROM | disk | FTP | other *** search
/ 2,000 Greater & Lesser Mysteries / 2,000 Greater and Lesser Mysteries.iso / internet / mys01117.txt < prev    next >
Encoding:
Text File  |  1994-06-10  |  5.8 KB  |  175 lines
  1. This first program checks the contents in a room and assembles a string
  2. which is an english description of the contents.  For example, for
  3.  
  4. Contents:
  5. a bell
  6. a book        it would print:         a bell, a book, and a candle.
  7. a candle
  8.  
  9. Contents:
  10. Huey          it would print:         Huey and Dewey
  11. Dewey
  12.  
  13. Contents:     it would print:         an apple     
  14. an apple
  15.  
  16. If there is nothing in the room, it will print "nothing."
  17.  
  18. (english-list)         (3 vars)          ( list -- s )
  19. (                                                    )
  20. (      list is a list of dbrefs with an integer on   )
  21. (      top  [a la 'contents'];  s is an English      )
  22. (      string describing said contents.              )
  23. (                                                    )
  24.  
  25. var manysofar
  26. var howmany
  27. var accumulate
  28. : itemprelist
  29.         dup 0 = if pop exit then       (check to see if we're done.     )
  30.         swap                     
  31.         manysofar @ 1 +    manysofar !     (count how many items we've seen.)
  32.         name
  33.         ", "                           
  34.         manysofar @ howmany @ 1 - = if     (separate items with a comma,    )
  35.                 pop ", and " then          (unless there are only two or it )
  36.         howmany @ 1 = if pop " " then      (is the last item in the list.   )
  37.         howmany @ 2 = if pop " and " then
  38.         manysofar @ howmany @ = if
  39.                 pop "." then               (end with a period.              )
  40.         strcat accumulate @ swap strcat
  41.           accumulate !                     (add the text to the new string. )
  42.         1 - itemprelist                    (if not done, loop around.       )
  43. ;
  44. : itemlist
  45.         dup howmany !     (howmany is the number of items in the list       ) 
  46.         0 manysofar !     (manysofar is how many we've counted; initialize. )
  47.         "" accumulate !
  48.         itemprelist       (do the loop that concats the item names together.)
  49.         accumulate @
  50.           "" strcmp if    (return the value of accumulate, or "nothing' if  )
  51.             accumulate @  (we didn't find anything in the room.             )
  52.           then "nothing."
  53. ;
  54.  
  55. (The next part actually puts the above program to use.)
  56.  
  57. : show-contents-in-English
  58.     me @
  59.       "In this room, you see "
  60.         loc @ contents     (get the list to pass to the function.            )
  61.         itemlist pop           
  62.       strcat
  63.     notify
  64. ;
  65.  
  66.  
  67. The next two are simple shortcuts to see if a player is male or female.
  68.  
  69.  
  70. ( male )                                    ( d -- i )
  71. (      d is the player's dbref, i is a boolean.      )
  72. (                                                    )
  73. : male
  74.     "sex" getpropstr "male" strcmp
  75.       if 0 exit then 1
  76. ;
  77.  
  78.  
  79. ( female )                                  ( d -- i )
  80. (      d is the player's dbref, i is a boolean.      )
  81. (                                                    )
  82. : female
  83.     "sex" getpropstr "female" strcmp
  84.       if 0 exit then 1
  85. ;
  86.  
  87.  
  88. This next is a little search-and-replace hack.
  89.  
  90. ( search-and-replace ) (3 vars) ( s1 s2 s3 -- s )
  91. (                                               )
  92. (  Searches through s1 for all occurences of    )
  93. (  word s3 and replaces them with s2.  Only     )
  94. (  occurences which stand alone  [are bordered  )
  95. (  by spaces on both sides] are detected.       )
  96. (  Not case sensitive.                          )
  97. (  Right now it's a bit tacky since it will     )
  98. (  miss words ending in punctuation; for this   )
  99. (  we need a strncmp primitive.                 )
  100. (                                               )
  101. var recurse
  102. var old_word
  103. var new_word
  104. : dostuff
  105.     recurse @ 2 < if exit then     (       If we're done, exit.             )
  106.     swap
  107.     dup
  108.       old_word @ stringcmp not     (If the word we're looking at now matches) 
  109.         if pop new_word @ then     (the word we're looking for, pop it and  )
  110.     " " swap strcat strcat         (replace with new_word.                  )
  111.                                    (Concatenate whatever still happens to be)
  112.                                    (there back onto the string we're re-    )
  113.                                    (constructing.                           )
  114.     recurse @ 1 - recurse !        (Update our recursion counter.           )
  115.     dostuff                        (Loop back and continue.                 )
  116. ;
  117. : search-and-replace
  118.     old_word !               (Set old_word and new_word to the parameters   )
  119.     new_word !               (we were passed.                               )
  120.     " " explode              (Explode the string we were passed [separate it)
  121.     recurse !                ( into words] for the loop to use.             )
  122.     dostuff                  (Do the loop.                                  )
  123. ;
  124.  
  125.                     (Written by Stinglai)
  126.  
  127. The next is an update [more readable, even] of the old one-armed bandit
  128. routine.
  129.  
  130. : abs        ( i -- i )           (absolute value)
  131.    dup
  132.      0 < if -1 * then
  133. ;
  134. : amt          ( -- i )           (random number between -100 and 100.)  
  135.     random 21 %
  136.     10 -
  137.     10 *
  138. ;
  139. : give         ( d -- )
  140.     me @ swap addpennies          (give the player some pennies)
  141. ;
  142. : msg    ( i s -- d s )
  143.     swap
  144.     abs intostr " pennies!"       (make tail half of the message)
  145.       strcat strcat
  146.     me @ swap
  147. ;
  148. : winlose
  149.     dup
  150.       dup
  151.         abs = dup             (is the number we got = to its absolute  )
  152.       if pop "win" exit       (value?  i.e., is it positive?           )
  153.       then not if "lose" then
  154. ;                             (send the right message accordingly.     )
  155. : tell
  156.     dup
  157.       winlose "You " swap     (print "You [win/lose] x pennies!"       )
  158.         strcat " " strcat
  159.         msg notify
  160. ;
  161. : announce
  162.     dup
  163.       loc @ swap me @ swap 
  164.                notify         (Tell the player what happened.          )
  165.       loc @ swap me @ swap
  166.          notify_except        (Tell everyone else what happened.       )
  167. ;
  168. : pull
  169.     amt tell announce give    (Main prog.)
  170.  
  171. ;
  172.  
  173.                    (Written by WhiteRabbit)
  174.  
  175.